home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / hypercar / xcmd / dartxcmd.sit / Dartmouth XCMD's 3.1 / card_18514.txt < prev    next >
Encoding:
Text File  |  1989-06-02  |  6.0 KB  |  243 lines
  1. -- card: 18514 from stack: in.1
  2. -- bmap block id: 0
  3. -- flags: 0000
  4. -- background id: 3241
  5. -- name: RInstall
  6. ----- HyperTalk script -----
  7. on Install
  8.   get ChooseTargetStack()
  9.   InstallResource XCMD,RInstall,it
  10. end Install
  11.  
  12.  
  13. -- part 1 (field)
  14. -- low flags: 81
  15. -- high flags: 2007
  16. -- rect: left=12 top=26 right=298 bottom=491
  17. -- title width / last selected line: 0
  18. -- icon id / first selected line: 0 / 0
  19. -- text alignment: 0
  20. -- font id: 22
  21. -- text size: 10
  22. -- style flags: 0
  23. -- line height: 13
  24. -- part name: Source
  25.  
  26.  
  27. -- part 2 (button)
  28. -- low flags: 00
  29. -- high flags: A003
  30. -- rect: left=299 top=300 right=322 bottom=438
  31. -- title width / last selected line: 0
  32. -- icon id / first selected line: 0 / 0
  33. -- text alignment: 1
  34. -- font id: 0
  35. -- text size: 12
  36. -- style flags: 0
  37. -- line height: 16
  38. -- part name: Show Pascal Source
  39. ----- HyperTalk script -----
  40. on mouseUp
  41.   set the visible of card field 1 to not the visible of card field 1
  42.   if the visible of card field 1 is true then
  43.     set the name of me to "Hide Pascal Source"
  44.   else set the name of me to "Show Pascal Source"
  45. end mouseUp
  46.  
  47.  
  48.  
  49. -- part contents for background part 16
  50. ----- text -----
  51. RINSTALL XCMD version 1.0
  52. Kevin Calhoun
  53.  
  54. RInstall copies any resource contained in any currently open resource file to a file you specify by full pathname.  It automatically removes from the target file any resource of the same type and name (or of the same type and resource ID) as the resource to be copied.
  55.  
  56. INVOKING RINSTALL
  57.  
  58. RInstall resType,resName,fileName
  59.  
  60. The first parameter, resType, is that type of resource you want to install.  The second parameter, resName, is the name of the resource you want to install.  The third parameter, fileName, is the full pathname of the file into which the resource is to be copied.
  61.  
  62. If an error occurs, RInstall returns an error message, the first word of which is 
  63. "Error".
  64.  
  65. REVISION HISTORY
  66. 30 April 1989  1.0
  67.  
  68. -- part contents for card part 1
  69. ----- text -----
  70. UNIT RInstall;
  71.  
  72. { RInstall XCMD ┬⌐1989 by the Trustees of Dartmouth College }
  73. { Written by Kevin Calhoun }
  74.  
  75. (*
  76. Pascal RInstall.p
  77. Link  -m ENTRYPOINT Γêé
  78.     -o "YourFile" Γêé
  79.     -rt XCMD=3128 Γêé
  80.     -sn Main=RInstall Γêé
  81.     RInstall.p.o Γêé
  82.     "{Libraries}"interface.o Γêé
  83.     "{PLibraries}"Paslib.o Γêé
  84.     "{Libraries}"HyperXLib.o
  85. *)
  86.  
  87. {$R-}
  88.  
  89. INTERFACE
  90.   USES
  91.     Types,
  92.     Memory,
  93.     Events,
  94.     Windows,
  95.     Files,
  96.     ToolUtils,
  97.     Resources,
  98.     SysEqu,
  99.     Errors,
  100.     HyperXCmd;
  101.  
  102.   PROCEDURE EntryPoint (paramPtr : XCMDPtr);
  103.  
  104. IMPLEMENTATION
  105.  
  106.   PROCEDURE ResInstall (paramPtr : XCMDPtr); FORWARD;
  107.  
  108.   PROCEDURE EntryPoint (paramPtr : XCMDPtr);
  109.   BEGIN
  110.     ResInstall(paramPtr);
  111.   END;
  112.  
  113.   PROCEDURE PassReturnValue (paramPtr: XCMDPtr; theMsg : Str255); { set theResult and quit }
  114.   BEGIN
  115.     paramPtr^.returnValue := PasToZero(paramPtr, theMsg);
  116.   END;
  117.  
  118.   FUNCTION MyOpenResFile(fileName: Str255; VAR refNum: INTEGER;
  119.                           VAR wasOpen: BOOLEAN): OSErr;
  120.     TYPE
  121.       HandlePtr = ^Handle;
  122.     VAR
  123.       oldTopMapHndl: Handle;
  124.   BEGIN
  125.     MyOpenResFile := noErr;
  126.     oldTopMapHndl := HandlePtr(TopMapHndl)^;  { remember current TopMapHndl }
  127.     refNum := OpenResFile(fileName);          { open resource file }
  128.     IF (refNum = -1) THEN { error opening file }
  129.       BEGIN
  130.       MyOpenResFile := ResError;
  131.       EXIT(MyOpenResFile);
  132.       END
  133.     ELSE
  134.       IF (oldTopMapHndl = HandlePtr(TopMapHndl)^) THEN wasOpen := TRUE
  135.         { no change -- it was open }
  136.       ELSE wasOpen := FALSE;
  137.         { res file wasn't open before }
  138.   END;
  139.  
  140.   PROCEDURE RemoveResource(rType: ResType; resID: INTEGER; name: Str255);
  141.     VAR
  142.       resAlready: Handle;
  143.   BEGIN
  144.     SetResLoad(FALSE);
  145.     REPEAT
  146.       resAlready := Get1Resource(rType, resID);
  147.       IF resAlready <> NIL THEN RmveResource(resAlready);
  148.     UNTIL resAlready = NIL;
  149.     REPEAT
  150.       resAlready := Get1NamedResource(rType, name);
  151.       IF resAlready <> NIL THEN RmveResource(resAlready);
  152.     UNTIL resAlready = NIL;
  153.     SetResLoad(TRUE);
  154.   END;
  155.     
  156.   PROCEDURE ResInstall(paramPtr: XCMDPtr);
  157.     LABEL
  158.       99,100;
  159.     VAR
  160.       err: OSErr;
  161.       targetFile, curFile: INTEGER;
  162.       str: Str255;
  163.       rType: ResType;
  164.       resource: Handle;
  165.       resID: INTEGER;
  166.       attrs: INTEGER;
  167.       targetStack: Str255;
  168.       wasOpen: BOOLEAN;
  169.       
  170.       PROCEDURE BailOut;
  171.       BEGIN
  172.         IF resource <> NIL THEN DisposHandle(resource);
  173.         GOTO 100;
  174.       END;
  175.  
  176.   BEGIN
  177.     err := noErr;
  178.     resource := NIL;
  179.     curFile := CurResFile;
  180.     
  181.     IF paramPtr^.paramCount < 3 THEN
  182.       BEGIN
  183.       PassReturnValue(paramPtr,'RInstall XCMD 1.0 ┬⌐1989 Dartmouth College');
  184.       Exit(ResInstall);
  185.       END;
  186.       
  187.     BlockMove(paramPtr^.params[1]^,@rType,4);
  188.     ZeroToPas(paramPtr, paramPtr^.params[2]^, str);
  189.     
  190.     resource := GetNamedResource(rType, str);
  191.     err := ResError;
  192.     IF err <> noErr THEN GOTO 100;
  193.     
  194.     GetResInfo(resource, resID, rType, str);
  195.     err := ResError;
  196.     IF err <> noErr THEN BailOut;
  197.  
  198.     attrs := GetResAttrs(resource);
  199.     
  200.     err := HandToHand(resource);
  201.     IF err <> noErr THEN BailOut;
  202.     
  203.     MoveHHi(resource);
  204.     HLock(resource);
  205.       
  206.     ZeroToPas(paramPtr,paramPtr^.params[3]^,targetStack);
  207.     
  208.     err := MyOpenResFile(targetStack, targetFile, wasOpen);
  209.     IF (targetFile = -1) AND (err = eofErr) THEN
  210.       BEGIN
  211.       wasOpen := FALSE;
  212.       CreateResFile(targetStack);
  213.       err := ResError;
  214.       IF err = noErr THEN targetFile := OpenResFile(targetStack);
  215.       END;
  216.     IF (err <> noErr) OR (targetFile = -1) THEN BailOut;
  217.  
  218.     UseResFile(targetFile);
  219.     RemoveResource(rType, resID, str);
  220.     AddResource(resource, rType, resID, str);
  221.     err := ResError;
  222.     IF err <> noErr THEN
  223.       BEGIN
  224.       DisposHandle(resource);
  225.       GOTO 99;
  226.       END;
  227.  
  228.     SetResAttrs(resource, attrs);
  229.     ChangedResource(resource);
  230.     WriteResource(resource);
  231.     UpdateResFile(targetFile);
  232.     err := ResError;
  233.     IF NOT wasOpen THEN CloseResFile(targetFile);
  234.     
  235.     99: UseResFile(curFile);
  236.     100: IF err <> noErr THEN
  237.       BEGIN
  238.       NumToStr(paramPtr, err, str);
  239.       PassReturnValue(paramPtr,CONCAT('Error ', str));
  240.       END;
  241.   END;
  242.  
  243. END.